PC Plus SuperCD (UK) 1997 May/PC Plus Super CD Issue 127 (May 1997).iso/handson/delphi/dbread/tlunit1.pas

Pascal/Delphi Source File | 1997-02-04 | 12.9 KB | 385 lines

unit Tlunit1;
(* PC PLUS Sample Delphi program to illustrate the use of TList objects. *)
(* Also shows how to import data from a text file:                       *)
(*    procedure TForm1.ImportBtnClick(Sender: TObject);                  *)
(* at the end of this unit.                                              *)

(* DELPHI 2 PROGRAMMERS NOTE! When reading strings from text files, you  *)
(* must specify a maximum string size. Delphi 2's default string is      *)
(* dynamically allocated. Delphi 1's default string is 255 chars.        *)
(* You can either declare a fixed-size Delphi 2 string (e.g. string[255])*)
(* or you can 'turn off' Delphi 2's long strings using the {$H-} compiler*)
(* directive. For simplicity, this is the approach taken in this project *)

{$IFDEF VER90}
{$H-}   (* turn off long strings if this is Delphi 2*)
{$ENDIF}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,
  StrUtils;

type

{ Define the objects to be put into the TList }
Thing = class(TObject)
  name        : string[20];
  description : string [50];
  value       : integer;
end;


  TForm1 = class(TForm)
    TListCreateBtn: TButton;
    MessageBox: TMemo;
    FreeThingsBtn: TButton;
    TListDestroyBtn: TButton;
    CountThingsBtn: TButton;
    ShowThingsBtn: TButton;
    ShowFirstBtn: TButton;
    ShowLastBtn: TButton;
    ExchangeFirstandLastBtn: TButton;
    ExitBtn: TButton;
    AddTenThingsBtn: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    NameEd: TEdit;
    DescEd: TEdit;
    ValEd: TEdit;
    AddThingBtn: TButton;
    ClearMessagesBtn: TButton;
    ImportBtn: TButton;
    procedure TListCreateBtnClick(Sender: TObject);
    procedure AddThingBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FreeThingsBtnClick(Sender: TObject);
    procedure TListDestroyBtnClick(Sender: TObject);
    procedure CountThingsBtnClick(Sender: TObject);
    procedure ShowThingsBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure ShowFirstBtnClick(Sender: TObject);
    procedure ShowLastBtnClick(Sender: TObject);
    procedure ExchangeFirstandLastBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure AddTenThingsBtnClick(Sender: TObject);
    procedure ClearMessagesBtnClick(Sender: TObject);
    procedure ImportBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure FreeThings;
    procedure FreeThingList;
    function  ThingListExists : boolean;
    function  ThingsInTheList : boolean;
    procedure ShowThing( T : Thing );
end;



var
  Form1: TForm1;
  MyThingList : TList;     { declare a TList variable }

implementation

{$R *.DFM}

function TForm1.ThingListExists : boolean;
{ Return true if the TList has been created and points to something }
begin
   if MyThingList = nil then
      ThingListExists := false
   else
      ThingListExists := true;
end;

function  TForm1.ThingsInTheList : boolean;
{ Return true if TList has been created and has some objects. Otherwise }
{ print an explanatory message.                                         }
begin
  ThingsInTheList := false;
  if not ThingListExists then
     MessageBox.Lines.Add( 'Thing List doesn''t exist!' )
  else if MyThingList.Count = 0 then
     MessageBox.Lines.Add( 'There are no Things in the list!' )
  else ThingsInTheList := True;
end;

procedure TForm1.FreeThings;
var
   i : integer;
begin
  { go through the TList, freeing the items }
  if ThingListExists then
  begin
     For i := 0 to MyThingList.Count - 1 do
         if MyThingList.Items[i] <> nil then
            Thing(MyThingList.Items[i]).Free;
     MyThingList.Clear;
  end;
end;

procedure TForm1.FreeThingList;
  { free the TList }
begin
  If ThingListExists then
  begin
     FreeThings;          { make sure all the objects are freed }
     MyThingList.Free;    { then free the TList itself          }
     MyThingList := nil;  { Finally, re-set TList to nil        }
  end;
end;


procedure TForm1.TListCreateBtnClick(Sender: TObject);
begin
  if not ThingListExists then
  begin
    MyThingList := TList.Create; { Create the TList }
    MessageBox.Lines.Add( 'MyThingList has now been created.');
  end
  else
    MessageBox.Lines.Add( 'ERROR: MyThingList has already been created!');
end;

procedure TForm1.AddThingBtnClick(Sender: TObject);
var
   i           :integer;
   FieldsOK    : boolean;
   newthing    : Thing;
begin
{ --- this whole first section checks that all the data fields contain --- }
{ --- appropriate values to create and add an object to our TList      --- }

 FieldsOK := true; { start by assuming that field contents are valid       }
 if ( (NameEd.Text = '') or (DescEd.Text = '') or (ValEd.Text = '') )then
 begin
      MessageDlg(  'You must enter a Name, a Description and a Value.',
                   mtInformation, [mbOk], 0);
      FieldsOK := false; { if they aren't valid, make this variable false }
 end
 else
 begin
    try   { check that ValEd.Text can be converted to an integer }
      i := StrToInt(ValEd.Text);
    except
      on EConvertError do
      begin
         i := 0;
         FieldsOK := false;
         MessageDlg(  '"' + ValEd.Text + '" is not a valid integer!',
                      mtInformation, [mbOk], 0);
      end;
    end; { try...except...}
 end;
 if FieldsOK then
 if not ThingListExists then { check that the TList has been created }
    MessageDlg( 'ERROR: Create a TList before you add an object!',
                      mtInformation, [mbOk], 0)
 else
 { If all is well, create a Thing object and add it to the ThingList TList }
 begin
    newthing := Thing.Create;
    newthing.name := NameEd.Text;
    newthing.description := DescEd.Text;
    newthing.value := i;       { our integer version of ValEd.Text }
    MyThingList.Add(newthing); { add it to the TList               }
    MessageBox.Lines.Add( 'New thing added at position '
                    + IntToStr(MyThingList.Count) );
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   { clean up when the application terminates }
   FreeThings;
   FreeThingList;
end;

procedure TForm1.FreeThingsBtnClick(Sender: TObject);
begin
   if ThingsInTheList then
   begin
      FreeThings;
      MessageBox.Lines.Add( 'All Things have been destroyed.');
   end;
end;

procedure TForm1.TListDestroyBtnClick(Sender: TObject);
{ Destroy the ThingList }
begin
  if not ThingListExists then { if it isn't created, it can't be destroyed }
    MessageBox.Lines.Add( 'MyThingList is already free.')
  else                        { if it contains things, free them first     }
  if MyThingList.Count > 0 then
         MessageBox.Lines.Add( 'Please free MyThingList''s objects first.')
  else
  begin
    FreeThingList;
    MessageBox.Lines.Add( 'OK. MyThingList has now been freed.');
  end;
end;

procedure TForm1.CountThingsBtnClick(Sender: TObject);
begin
  if ThingsInTheList then
     MessageBox.Lines.Add(IntToStr( MyThingList.Count )
                                    + ' items in the TList. ' );
end;

procedure TForm1.ShowThing( t : Thing );
{ Given a Thing 't', print its data fields in the MessageBox memo }
var
   s : string;
begin
   s := 'Thing[' + IntToStr(MyThingList.IndexOf(t)) +
       '] Name: "' + t.name
       + '", Description: "' + t.description
       + '", Value: ' + IntToStr(t.Value);
   MessageBox.Lines.Add( s );
end;


procedure TForm1.ShowThingsBtnClick(Sender: TObject);
{ display data of all Things in memo }
var
   i : integer;
begin
  if ThingsInTheList then
    for i := 0 to MyThingList.Count - 1 do
      ShowThing( MyThingList.Items[i] );
end;

procedure TForm1.ExitBtnClick(Sender: TObject);
begin
   Close;
end;


procedure TForm1.ShowFirstBtnClick(Sender: TObject);
{ display data of first Thing in memo }
begin
   If ThingsInTheList then
      ShowThing(MyThingList.First);
end;

procedure TForm1.ShowLastBtnClick(Sender: TObject);
{ display data of last Thing in memo }
begin
   If ThingsInTheList then
      ShowThing(MyThingList.Last);
end;

procedure TForm1.ExchangeFirstandLastBtnClick(Sender: TObject);
{ swap first and last things in the TList }
begin
   if ThingsInTheList then
   if MyThingList.Count = 1 then
      MessageBox.Lines.Add('ERROR: You need at least 2 items to exchange them!')
   else
   begin
      MyThingList.Exchange(
         MyThingList.IndexOf(MyThingList.First),  { use IndexOf to provide an  }
         MyThingList.IndexOf(MyThingList.Last) ); { integer value of First+Last}
      MessageBox.Lines.Add('First and Last items have been exchanged.');
   end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
   { In fact, a TList is automatically initialised to nil }
   { prior to being created. Still, best to be explicit   }
   { about this!                                          }
   MyThingList := nil;
end;

procedure TForm1.AddTenThingsBtnClick(Sender: TObject);
var
   i : integer;
   newthing : Thing;
begin
 if not ThingListExists then { check that the TList has been created }
    MessageDlg( 'ERROR: Create a TList before you add objects!',
                      mtInformation, [mbOk], 0)
    else
    begin
       for i := 1 to 10 do
       begin
           newthing := Thing.Create;
           newthing.name := 'A Thing';
           newthing.description := 'A Description';
           newthing.value := i;
           MyThingList.Add(newthing); { add it to the TList }
       end;
       MessageBox.Lines.Add( 'Ten things added to the list.' );
    end;
end;

procedure TForm1.ClearMessagesBtnClick(Sender: TObject);
begin
   MessageBox.Clear;
end;

{ ---------------------------------------------------------------------------- }
{ ------------------ THE NEW CODE STARTS HERE -------------------------------- }
{ ---------------------------------------------------------------------------- }
{ This procedure imports comma-delimited data from the file Test.txt           }
{ Note that, in real-world application, you would need to add a good deal of   }
{ error checking to operations such as this. For example, you would need to    }
{ check that the directory is valid (e.g. recover when if you are trying       }
{ to read from an empty floppy disk drive). And you'd need to check that each  }
{ item is valid. For simplicity, I have omitted these checks. As a result, the }
{ following assumptions are made:                                              }
{ 1) That the file, Test.txt contains a list of records, 1 record per line     }
{ 2) That each line comprises a comma-delimited list of 3 items                }
{ 3) That items 1 and 2 are Strings and that item 3 can be converted to integer}
procedure TForm1.ImportBtnClick(Sender: TObject);
var
   TFile         : TextFile;
   TLine         : string;
   str, f, r     : string;
   newthing      : Thing;
begin
    if not FileExists( 'Test.txt' ) then        { Check that input file exists }
        ShowMessage('File: TEST.TXT not found!')
    else
    begin
      if not ThingListExists then
        MyThingList := TList.Create;            { Create the TList             }
           { If the file exists, then Open it for reading                      }
      AssignFile(TFile, 'Test.txt' );
      Reset(TFile);
      MessageBox.Lines.Add( '* File Test.txt has been opened for reading. *' );
           { Read lines until at Eof (End of file)                             }
      While not Eof(TFile) do
      begin
        newthing := Thing.Create;  { create an object of type Thing            }
        Readln(TFile, TLine );     { read a line from the input file           }
        MessageBox.Lines.Add( 'Line read: [' + TLine + ']' );
                                   { parse the line into data items to match   }
        firstrestStr(TLine, f, r );{ the data fields of a Thing object         }
        newthing.name := f;
        str := r;
        firstrestStr(str, f, r );
        newthing.description := f;
        str := r;
        firstrestStr(str, f, r );
        newthing.value := StrToInt( f );
                                  { Add newthing object to MyThingList TList   }
        MyThingList.Add( newthing );
      end; { END: While not Eof Loop }
      CloseFile(TFile);           { When there's no more to read, close file   }
      MessageBox.Lines.Add( '* File Test.txt has now been closed! *' );
    end; { END: FileExists Block }
end;
{ ---------------------------------------------------------------------------- }
{ ------------------ THE NEW CODE ENDS HERE ---------------------------------- }
{ ---------------------------------------------------------------------------- }

end.